home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disk User Volume 2 #4 / Commodore_Disk_User_Vol.2_4_1989_-.d64 / filter demo (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  7KB  |  238 lines

  1. 100 rem *   filter demo program      *
  2. 110 rem * for use with sid sequencer *
  3. 120 rem *    by v.h.berry 1989       *
  4. 200 gosub 50010:rem initialisation
  5. 210 gosub 30010:rem enter filename
  6. 220 gosub 40010:rem load music
  7. 230 gosub 42010:rem load sound
  8. 240 gosub 5010:rem print screen
  9. 250 gosub 2010:rem start music
  10. 1000 rem sweep filter routine
  11. 1010 a=d1:d1=d2:d2=a:sw=-sw:i=d1
  12. 1020 get k$:if k$=chr$(136) then 1510:rem f7 exit program
  13. 1022 if k$=chr$(135) then gosub 2010:rem f5 music on/off
  14. 1024 if k$=chr$(134) then gosub 6010:rem f3 help
  15. 1026 if k$=chr$(133) then gosub 1810:rem f1 change sweep parameters
  16. 1028 if k$="1" then fg=f1:gosub 1610:f1=fg:gosub 1710:rem chan 1 filter on/off
  17. 1030 if k$="2" then fg=f2:gosub 1610:f2=fg:gosub 1710:rem chan 2 filter on/off
  18. 1032 if k$="3" then fg=f3:gosub 1610:f3=fg:gosub 1710:rem chan 3 filter on/off
  19. 1034 if k$="h" then fg=hp:gosub 1610:hp=fg:gosub 1710:rem high pass on/off
  20. 1036 if k$="l" then fg=lp:gosub 1610:lp=fg:gosub 1710:rem low pass on/off
  21. 1038 if k$="b" then fg=bp:gosub 1610:bp=fg:gosub 1710:rem band pass on/off
  22. 1040 if k$="v" then fg=volume:gosub 1660:volume=fg:gosub 1710:rem increase volume
  23. 1042 if k$="[214]" then fg=volume:gosub 1680:volume=fg:gosub 1710:rem decrease volume
  24. 1044 if k$="r" then fg=res:gosub 1660:res=fg:gosub 1710:rem increase resonance
  25. 1046 if k$="[210]" then fg=res:gosub 1680:res=fg:gosub 1710:rem decrease resonance
  26. 1050 i=i+sw:if (sgn(sw)=1)and(i>=d2) then 1010
  27. 1060 if (sgn(sw)=-1)and(i<=d2) then 1010
  28. 1080 poke sid+22,i:print"";tab(29);"    [157][157][157][157]";i
  29. 1090 goto 1020
  30. 1500 rem exit program
  31. 1510 print"[147]filter demo"
  32. 1520 print"v.h.berry"
  33. 1530 print"1989."
  34. 1540 end
  35. 1600 rem on/off routine
  36. 1610 if fg=0 then fg=1:return
  37. 1620 fg=0:return
  38. 1650 rem increment/decrement parameter
  39. 1660 fg=fg+1:if fg>15 then fg=15
  40. 1670 return
  41. 1680 fg=fg-1:if fg<0 then fg=0
  42. 1690 return
  43. 1700 rem new filter setting
  44. 1710 gosub 50280:rem calculate new values
  45. 1720 gosub 2030:rem alter sid registers
  46. 1730 gosub 5220:rem print values
  47. 1740 return
  48. 1800 rem alter sweep filter parameters
  49. 1810 print"[147] change sweep filter parameters [146]"
  50. 1811 print"[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  51. 1812 print"       sweep rate"
  52. 1814 print"       limit 'x'"
  53. 1816 print"       limit 'y'"
  54. 1818 print"       continue"
  55. 1819 print"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  56. 1820 gosub 5110:rem screen parameters
  57. 1830 print"";:ll=3:t1=4:gosub 39010:rem menu routine
  58. 1840 if a=3 then i=d1:gosub 5020:return
  59. 1845 fg=a:print"";tab(20);"enter value (0-255)[146]"
  60. 1850 l=3:tb=25:rs=0:gosub 32040:rem input subroutine
  61. 1855 if y$="" then 1810
  62. 1856 if val(y$)<0 or val(y$)>255 then print tab(25);"":goto 1850
  63. 1860 if fg=0 then sw=val(y$):rem change rate
  64. 1862 if fg=1 then d1=val(y$):rem change lower limit
  65. 1864 if fg=2 then d2=val(y$):rem change upper limit
  66. 1866 if d1>d2 and sgn(sw)=1 then sw=-sw
  67. 1868 if d1<d2 and sgn(sw)=-1 then sw=-sw
  68. 1870 goto 1810
  69. 2000 rem music on/off
  70. 2010 if mf=1 then mf=0:sys 49209:return:rem music off
  71. 2020 mf=1:sys 49235:rem music on
  72. 2030 poke sid+24,fl:poke sid+23,rn
  73. 2040 return
  74. 5000 rem main screen
  75. 5010 poke 53280,0:poke 53281,0
  76. 5020 print"[147]"
  77. 5030 print"        *** filter demo ***"
  78. 5040 print"    file : ";n$
  79. 5050 print"     f1      f3      f5      f7 [146]"
  80. 5060 print"sweep filterhelpmusic on/offexit[146]"
  81. 5110 print"[176]{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}[174]"
  82. 5120 print"{$7d}passfilters{$7d} filter parameters "
  83. 5130 print"[171]{$60}{$60}{$60}{$60}[178]{$60}{$60}{$60}{$60}[178]{$60}{$60}{$60}{$60}[179][176]{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}[174]"
  84. 5140 print"{$7d}high{$7d}low{$7d}band{$7d}{$7d}sweepctrl{$7d}"
  85. 5150 print"{$7d}{$7d}{$7d}{$7d}[171]{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}[179]"
  86. 5160 print"[171]{$60}{$60}{$60}{$60}{$7b}{$60}{$60}{$60}{$60}{$7b}{$60}{$60}{$60}{$60}[179]{$7d}limit-{$7d}"
  87. 5170 print"{$7d}1{$7d}[158]2{$7d}3{$7d}[171]{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}[179]"
  88. 5180 print"{$7d}{$7d}{$7d}{$7d}{$7d}rate{$7d}"
  89. 5190 print"[171]{$60}{$60}{$60}{$60}[177]{$60}{$60}{$60}{$60}[177]{$60}{$60}{$60}{$60}[179][173]{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}[189]"
  90. 5200 print"{$7d}resonance{$7d}"
  91. 5210 print"[173]{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}[189]"
  92. 5220 print"    ";
  93. 5230 if hp=1 then print"[157][157][157][157] on [146]";
  94. 5240 print"    ";:if lp=1 then print"[157][157][157][157] on [146]";
  95. 5250 print"    ";:if bp=1 then print"[157][157][157][157] on [146]";
  96. 5260 print
  97. 5270 print"    ";:if f1=1 then print"[157][157][157][157] on [146]";
  98. 5280 print"    ";:if f2=1 then print"[157][157][157][157][158] on [146]";
  99. 5290 print"    ";:if f3=1 then print"[157][157][157][157] on [146]";
  100. 5300 print
  101. 5310 print"    [157][157][157][157]";str$(res)
  102. 5320 print"";tab(24);"    [157][157][157][157]";str$(d1);" -    [157][157][157][157]";str$(d2)
  103. 5330 print tab(24);"    [157][157][157][157]";str$(sw)
  104. 5340 return
  105. 6000 rem help screen
  106. 6010 poke 53280,5:poke 53281,5:print"[147]";
  107. 6011 print" [f7] to continue                       [146][144]filtercontrols"
  108. 6012 print"{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}{$60}"
  109. 6013 print"[h][146][144]highpasson/off"
  110. 6014 print"[l][146][144]lowpasson/off"
  111. 6015 print"[b][146][144]bandpasson/off"
  112. 6016 print"[1][146][144]filterchannel1in/out"
  113. 6017 print"[2][146][144]filterchannel2in/out"
  114. 6018 print"[3][146][144]filterchannel3in/out"
  115. 6019 print"increase/decreaseresonance"
  116. 6020 print"[r][shift] & [r]"
  117. 6021 print"[144]increase/decreasevolume"
  118. 6022 print"[v][shift] & [v]"
  119. 6120 get k$:if k$<>chr$(136) then 6120
  120. 6130 gosub 5010:rem main screen
  121. 6140 return
  122. 30000 rem input new filename
  123. 30010 poke 53280,5:poke 53281,5
  124. 30020 print"[147] enter new filename : press [return]  [146]";
  125. 30030 print
  126. 30040 print"file : ";n$
  127. 30050 print""
  128. 30060 l=14:tb=5:rs=1:gosub 32040:rem input subroutine
  129. 30070 if a>0 then n$=y$
  130. 30080 poke 53280,0:poke 53281,0
  131. 30085 print"[147]file : ";n$
  132. 30090 return
  133. 32000 rem input restriction subroutine
  134. 32010 rem l=length of input
  135. 32020 rem tb=tabulation of routine
  136. 32030 rem rs=character restrictions
  137. 32040 a=0:y$="":sp=1
  138. 32050 print tab(tb+l+1):print"[145][174][157][189][145]";:for x=0 to l+1:print"[157][157] ";:next:print"[145][176][157][173][145][164][157]";
  139. 32060 get x$:if x$="" then 32060
  140. 32070 if x$=chr$(160) or x$=" " or x$=chr$(20) or x$=chr$(13) then 32130
  141. 32080 if rs=0 then if x$=>"0" and x$=<"9" then 32130
  142. 32090 if rs=1 and x$=>chr$(35) and x$=<chr$(93) then 32130
  143. 32100 goto 32060
  144. 32110 if a=l-1 then print"[157][157]";
  145. 32120 goto 32060
  146. 32130 if x$=chr$(20) and a=0 then 32060
  147. 32140 if x$=chr$(13) and right$(y$,1)=" " then y$=left$(y$,len(y$)-1):a=a-1
  148. 32150 if x$=chr$(13) then print:return
  149. 32160 a=a+1:if x$<>chr$(32) then sp=0
  150. 32170 if a>l and x$<>chr$(20) then x$="":a=a-1
  151. 32180 if a<1 then x$="":a=0
  152. 32190 if x$=chr$(20) then print tab(a)"[157][164] [157][157]";:a=a-2:y$=left$(y$,len(y$)-1):goto 32110
  153. 32200 if x$=chr$(32) and sp=1 then x$="":a=a-1
  154. 32210 if x$=chr$(32) then sp=sp+1
  155. 32220 y$=y$+x$:print x$;:if a<l then print"[164][157]";
  156. 32230 goto 32060
  157. 39000 rem menu system routine
  158. 39010 a=0:print tab(t1);">"
  159. 39020 get x$:if x$="" then 39020
  160. 39030 if a=ll and x$=chr$(17) then a=a-1:print"[145][145]"
  161. 39040 if a=0 and x$=chr$(145) then a=a+1:print
  162. 39050 if x$=chr$(17) then a=a+1:print tab(t1);"[145] [157]>"
  163. 39060 if x$=chr$(145) then a=a-1:print tab(t1);"[145] [157][145]>"
  164. 39070 if x$=chr$(13) then return
  165. 39080 goto 39020
  166. 40000 rem load music file
  167. 40010 x$=".1":i=0
  168. 40020 n=0
  169. 40030 open 15,8,15
  170. 40040 open 2,8,2,n$+x$+",s,r"
  171. 40050 input#15,en,er$,tr,se
  172. 40060 if en<>0 then print"[147] load[146]";:goto 44010
  173. 40070 print" loading music file :                 [146]";
  174. 40080 input#2,a
  175. 40090 poke ch+i*256+n,a
  176. 40100 if a<>255 then n=n+1:goto 40080
  177. 40110 n(i+1)=n
  178. 40120 close 2
  179. 40130 close 15
  180. 40140 if i=0 then i=1:x$=".2":goto 40020
  181. 40150 if i=1 then i=2:x$=".3":goto 40020
  182. 40160 return
  183. 42000 rem load fsid registers
  184. 42010 open 15,8,15
  185. 42020 open 2,8,2,n$+".s,s,r"
  186. 42030 input#15,en,er$,tr,se
  187. 42040 if en<>0 then print"[147] load[146]";:goto 44010
  188. 42050 print" loading sound file :                [146]";
  189. 42060 input#2,a
  190. 42070 poke 49275,a
  191. 42080 for ce=0 to 2
  192. 42090 for rg=0 to 6
  193. 42100 input#2,a
  194. 42110 poke fsid+rg+7*ce,a
  195. 42120 next rg,ce
  196. 42130 close 2
  197. 42140 close 15
  198. 42150 return
  199. 44000 rem file error routine
  200. 44010 close 2:close 15
  201. 44020 print" error : press [return]          [146]";:print
  202. 44030 print"file : ";n$
  203. 44040 print"error # : ";en:print"";er$:print"tr = ";tr;" : se = ";se
  204. 44050 get k$:if k$<>chr$(13) then 44050
  205. 44060 return
  206. 50000 rem initialisation
  207. 50010 if peek(51712)=1 then 50120:rem machine code present
  208. 50020 rem load machine code
  209. 50030 poke 53280,5:poke 53281,5
  210. 50040 print"[147][176][174]"
  211. 50050 print"filter demo"
  212. 50060 print"v.h.berryc.1989"
  213. 50070 print"[173][189]"
  214. 50080 print"loadingmachinecode"
  215. 50090 fg=fg+1:if fg=1 then load"sequencer mc",8,1
  216. 50100 if fg=2 then load "note table mc",8,1
  217. 50110 rem define system variables
  218. 50120 n$="demo file":rem default filename
  219. 50130 fsid=49175:rem false sid address
  220. 50140 ch=51968:rem channel data address
  221. 50150 sid=54272:rem sound chip address
  222. 50152 bk$="    "
  223. 50160 rem define filter parameters
  224. 50170 volume=8:res=12
  225. 50180 rem filters settings
  226. 50190 f1=0:rem channel 1 filter off
  227. 50200 f2=1:rem channel 2 filter on
  228. 50210 f3=1:rem channel 3 filter on
  229. 50220 hp=0:rem high pass off
  230. 50230 lp=0:rem low pass off
  231. 50240 bp=1:rem band pass on
  232. 50250 rem sweep settings
  233. 50260 d1=10:d2=180:rem depth of sweep high and low
  234. 50270 sw=10:rem speed of sweep
  235. 50280 fl=volume+lp*16+bp*32+hp*64
  236. 50290 rn=res*16+f3*4+f2*2+f1
  237. 50300 return
  238.